C ======================================================================
C
C       L I N K E D   L I S T   H A N D L E R
C
C       External: There are two record types, HEAD (list headers)
C                 and LINK (list elements).
C
C       Internal: Each of these is a LINKAGE element, with two pointers,
C                 PRED & SUCC.
C
C       A list is a circular list, where
C           each PRED/SUCC pointer points to the previous/next item,
C           but is negative if the previous/next item is a HEAD record.
C
C       (Thus) an empty list has both pointers in the HEAD negative.
C
C       An unattached LINK has zero pointers.
C
C ----------------------------------------------------------------------
C
C       L L C R E L   -   Create a list element
C

        INTEGER FUNCTION LLCREL(ARRAY,HSIZE)
        INTEGER ARRAY(*),HSIZE

        INTEGER BLOCK

        INTEGER LLGMEM
        EXTERNAL LLGMEM

        BLOCK=LLGMEM(ARRAY,HSIZE+2)
        ARRAY(BLOCK)=0
        ARRAY(BLOCK+1)=0
        LLCREL=BLOCK+2

        END
C ----------------------------------------------------------------------
C
C       L L C R H E   -   Create a list head
C

        INTEGER FUNCTION LLCRHE(ARRAY,HSIZE)
        INTEGER ARRAY(*),HSIZE

        INTEGER BLOCK

        INTEGER LLGMEM
        EXTERNAL LLGMEM

        BLOCK=LLGMEM(ARRAY,HSIZE+2)
        LLCRHE=BLOCK+2
        ARRAY(BLOCK)=-LLCRHE
        ARRAY(BLOCK+1)=-LLCRHE

        END
C ----------------------------------------------------------------------
C
C       L L C R H D   -   Create a list head with data
C

        INTEGER FUNCTION LLCRHD(ARRAY,HSIZE,HDATA)
        INTEGER ARRAY(*),HSIZE,HDATA(HSIZE)

        INTEGER I

        INTEGER LLCRHE

        LLCRHD=LLCRHE(ARRAY,HSIZE)
        DO 100 I=1,HSIZE
            ARRAY(LLCRHD+I-1)=HDATA(I)
 100    CONTINUE

        END
C ----------------------------------------------------------------------
C
C       L L C R E D   -   Create a list element with data
C

        INTEGER FUNCTION LLCRED(ARRAY,LSIZE,LDATA)
        INTEGER ARRAY(*),LSIZE,LDATA(LSIZE)

        INTEGER I

        INTEGER LLCREL

        LLCRED=LLCREL(ARRAY,LSIZE)
        DO 100 I=1,LSIZE
            ARRAY(LLCRED+I-1)=LDATA(I)
 100    CONTINUE

        END
C ----------------------------------------------------------------------
C
C       L L O U T   -   Remove an element from a list
C

        SUBROUTINE LLOUT(ARRAY,LINK)
        INTEGER ARRAY(*),LINK

        INTEGER I

C If not in any list, just return
        IF (ARRAY(LINK-1).EQ.0) RETURN
C Set L.PRED.SUCC:-L.SUCC
        ARRAY(ABS(ARRAY(LINK-1))-2)=ARRAY(LINK-2)
C Set L.SUCC.PRED:-L.PRED
        ARRAY(ABS(ARRAY(LINK-2))-1)=ARRAY(LINK-1)
C Clear pointers
        ARRAY(LINK-1)=0
        ARRAY(LINK-2)=0

        END
C ----------------------------------------------------------------------
C
C       L L P R E C   -   Make one linkage precede another
C       L L I N T O   -   Insert an element into a list
C

        SUBROUTINE LLPREC(ARRAY,LINK,LINKAG)
        INTEGER ARRAY(*),LINK,LINKAG

        ENTRY LLINTO(ARRAY,LINK,LINKAG)

        INTEGER PRED

        PRED=ABS(ARRAY(LINKAG-1))

C Remove LINK from any current list
        IF (ARRAY(LINK-1).NE.0) CALL LLOUT(ARRAY,LINK)

C Set SUCC(LINK)=SUCC(PRED(LINKAG))
        ARRAY(LINK-2)=ARRAY(PRED-2)
C Set SUCC(PRED)=LINK
        ARRAY(PRED-2)=LINK
C Set PRED(LINK)=PRED(LINKAG)
        ARRAY(LINK-1)=ARRAY(LINKAG-1)
C Set PRED(LINKAG)=LINK
        ARRAY(LINKAG-1)=LINK
C If SUCC(LINKAG).EQ.LINKAG, set SUCC(LINKAG)=LINK
        IF (ARRAY(LINKAG-2).EQ.-LINKAG) ARRAY(LINKAG-2)=LINK

        END
C ----------------------------------------------------------------------
C
C       L L F O L L   -   Make a link follow a linkage
C

        SUBROUTINE LLFOLL(ARRAY,LINK,LINKAG)
        INTEGER ARRAY(*),LINK,LINKAG

        INTEGER SUCC

        SUCC=ABS(ARRAY(LINKAG-2))

C Remove LINK from any current list
        IF (ARRAY(LINK-1).NE.0) CALL LLOUT(ARRAY,LINK)

C  L.PRED :- LINKAGE.SUCC.PRED      ! copy LINKAG ptr from its successor
C                                   ! (back-link from new element)
        ARRAY(LINK-1)=ARRAY(SUCC-1)

C  LINKAGE.SUCC.PRED :- L           ! back-link to new element
        ARRAY(SUCC-1)=LINK

C  L.SUCC :- LINKAGE.SUCC           ! forward link from new element
        ARRAY(LINK-2)=ARRAY(LINKAG-2)

C  LINKAGE.SUCC :- L                ! forward link to next element
        ARRAY(LINKAG-2)=LINK

        END
C ----------------------------------------------------------------------
C
C       L L N E X T   -   Return next element of list or 0 if last
C       L L F I R S   -   Return first element of list
C

        INTEGER FUNCTION LLNEXT(ARRAY,ITEM)
        INTEGER ARRAY(*),ITEM

        INTEGER LLFIRS
        ENTRY LLFIRS(ARRAY,ITEM)

        LLNEXT=MAX(ARRAY(ITEM-2),0)

        END
C ----------------------------------------------------------------------
C
C       L L P R E D   -   Return predecessor of item
C

        INTEGER FUNCTION LLPRED(ARRAY,ITEM)
        INTEGER ARRAY(*),ITEM

        LLPRED=ABS(ARRAY(ITEM-1))

        END
C ----------------------------------------------------------------------
C
C       L L P R E V   -   Return previous element of list or 0 if first
C       L L L A S T   -   Return last element of list
C

        INTEGER FUNCTION LLPREV(ARRAY,ITEM)
        INTEGER ARRAY(*),ITEM

        INTEGER LLLAST
        ENTRY LLLAST(ARRAY,ITEM)

        LLPREV=MAX(ARRAY(ITEM-1),0)

        END
C ----------------------------------------------------------------------
C
C       L L H E A D   -   Return head of a list
C

        INTEGER FUNCTION LLHEAD(ARRAY,LINK)
        INTEGER ARRAY(*),LINK

        IF (ARRAY(LINK-1).EQ.0) CALL ERROR('LLHEAD: Detached link')
        LLHEAD=LINK
 100    LLHEAD=ARRAY(LLHEAD-1)
        IF (LLHEAD.GT.0) GOTO 100
        LLHEAD=-LLHEAD

        END
C ----------------------------------------------------------------------
C
C       L L D E L E   -   Delete a list element
C

        SUBROUTINE LLDELE(ARRAY,LINK)
        INTEGER ARRAY(*),LINK

        EXTERNAL LLFREE

        IF (ARRAY(LINK-1).NE.0) CALL LLOUT(ARRAY,LINK)
        CALL LLFREE(ARRAY,LINK-2)

        END
C ----------------------------------------------------------------------
C
C       L L D E L H   -   Delete a list head
C

        SUBROUTINE LLDELH(ARRAY,HEAD)
        INTEGER ARRAY(*),HEAD

        EXTERNAL LLFREE

        IF (ARRAY(HEAD-2).GT.0) CALL ERROR('LLDELH: List is''t empty')
        CALL LLFREE(ARRAY,HEAD-2)

        END
C ----------------------------------------------------------------------
C
C       L L F I N D   -   Find a value in a list or sub-list
C
C       Given a head pointer, returns 0 or a pointer to the first elt
C       which matches VALUE, OFFSET specifying which field (word) to
C       check (0=first).
C
C       Given a link pointer, does exactly the same but only that part
C       of the list *past* the given pointer is checked (i.e. acts as
C       a "find next occurrence" routine).
C
C       If a nil pointer is passed (i.e. zero) the 0 return is given.
C

        INTEGER FUNCTION LLFIND(ARRAY,LINKAG,OFFSET,VALUE)
        INTEGER ARRAY(*),LINKAG,OFFSET,VALUE

        INTEGER LLNEXT

        IF (LINKAG.EQ.0) THEN
            LLFIND=0
        ELSE
            LLFIND=LLNEXT(ARRAY,LINKAG)
            IF (LLFIND.EQ.0) RETURN
 100        IF (ARRAY(LLFIND).NE.VALUE) THEN
                LLFIND=LLNEXT(ARRAY,LLFIND)
                IF (LLFIND.NE.0) GOTO 100
            END IF
        END IF

        END

